home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbpxen / pxmodule.bas < prev    next >
BASIC Source File  |  1991-10-07  |  14KB  |  417 lines
  1. '
  2. '  Written by Steve Jackson 
  3. '             9152 Brabham Drive
  4. '             Huntington Beach, CA 92646
  5. '
  6. '  Thanks to John Jaster for some of the dll definitions
  7. '
  8. '  Most of the engine functions are defined here, but not all.
  9. '  One that I have not gotten to work is PxErrMsg because it returns
  10. '  a pointer.  Visual Basic has no pointer types (that I know of).  
  11. '  You might get it to work by get a pointer to windows memory and
  12. '  using that, but it is beyond me right now.
  13. '
  14. '  This module is meant to be a general purpose visual basic interface
  15. '  to the Paradox engine DLL.  To run it, you need the DLL from Paradox
  16. '  Engine.  An example of usage is distributed in little video rental 
  17. '  application called VVDEMO.  
  18. '
  19. '  Comments, questions are welcome.  If you know of any ways I can
  20. '  earn a little extra income to purchase a faster computer (and with
  21. '  more memory) that would be welcome too.
  22. ' 
  23. '******* Declarations for Using the Paradox 3.5 Engine ******
  24. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  25. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  26. '************ TABLE FUNCTIONS *****************
  27. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  28. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  29. '************* RECORD FUNCTIONS *******************
  30. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  31. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  32. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  33. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  34. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  35. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  36. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  37. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  38. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  39. Declare Function PXRecLast Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  40. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  41. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  42. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  43. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  44. '**************** FIELD FUNCTIONS ****************
  45. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  46. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue#) As Integer
  47. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  48. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  49. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  50. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  51. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  52. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  53. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  54. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  55. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, Blank%) As Integer
  56. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  57. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  58. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  59. Declare Function PXFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  60. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  61. '*************** SEARCH FUNCTIONS *******************
  62. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  63. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  64. '***************** MISCELLANEOUS FUNCTIONS ****************
  65. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate As Any, mm%, dd%, yy%) As Integer
  66. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  67. ' note: PXErrMsg returns a string, not an integer
  68. Declare Function PXErrMsg Lib "Pxengwin.dll" (ByVal error_code%) As String
  69. '******************* NETWORK FUNCTIONS ******************
  70. Declare Function PXNetUserName Lib "Pxengwin.dll" (ByVal buffer%, UserName$) As Integer
  71. Declare Function PXNetFileLock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  72. Declare Function PXNetFileUnlock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  73. Declare Function PXNetTblLock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  74. Declare Function PXNetTblUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  75. Declare Function PXNetRecLock Lib "Pxengwin.dll" (ByVal TblHnd%, LockHnd%) As Integer
  76. Declare Function PXNetRecUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal LockHnd%) As Integer
  77. Declare Function PXNetRecLocked Lib "Pxengwin.dll" (ByVal TblHnd%, Locked%) As Integer
  78. Declare Function PXNetTblChanged Lib "Pxengwin.dll" (ByVal TblHnd%, Changed%) As Integer
  79. Declare Function PXNetTblRefresh Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  80. '
  81. ' Variables used only in this module
  82. '
  83. ' What must be defined in global:  NUMBER_OF_TABLES
  84. '
  85. '
  86. Dim hTable(NUMBER_OF_TABLES) As Integer
  87. Dim hRecBuf(NUMBER_OF_TABLES) As Integer
  88. Dim hRecLock(NUMBER_OF_TABLES) As Integer
  89. Dim iTableIsClosed(NUMBER_OF_TABLES) As Integer
  90.  
  91. Dim alpha_field As String * 256
  92. Dim px As Integer
  93.  
  94. Const PX_OK = 0
  95. Const PX_ENDOFTABLE = 101
  96. Const PX_STARTOFTABLE = 102
  97. Const PX_RECNOTFOUND = 89
  98. Const PX_KEYVIOL = 97
  99. Const PX_RECDELETED = 50
  100. Const PX_RECLOCKED = 9
  101.  
  102. Sub PXError (ByVal error_code As Integer)
  103.     '
  104.     '  General purpose error trapping.
  105.     '  If the error is not critical (that is, the database is OK),
  106.     '  return to the user.  Store message that they can retrieve if
  107.     '  needed by calling dberrormsg().
  108.     '
  109.     '  If the error is critical, processing cannot continue, and
  110.     '  this routine will END THE PROGRAM
  111.     '
  112.     If error_code = PX_OK Then
  113.         Exit Sub
  114.     End If
  115.     '
  116.     '   Non-critical errors:
  117.     '
  118.     Select Case error_code
  119.         Case PX_OK
  120.             Exit Sub
  121.         Case PX_ENDOFTABLE, PX_STARTOFTABLE, PX_KEYVIOL
  122.             Exit Sub
  123.         Case PX_RECNOTFOUND, PX_RECDELETED
  124.             Exit Sub
  125.     End Select
  126.  
  127.     Msg$ = "Paradox database error code: " + Str$(error_code)
  128.     ' alpha_field = PXErrMsg(error_code)
  129.     ' Msg$ = Msg$ + alpha_field
  130.     MsgBox Msg$, 0 + 16, "Database Error"
  131.     End
  132. End Sub
  133.  
  134. Function DBInit (ByVal AppName$) As Integer
  135.     '
  136.     ' Start the paradox engine for windows
  137.     ' for now always use mode of: PXSHARED
  138.     '
  139.     px = PXWinInit(AppName$, 2)
  140.     If px = 82 Then
  141.         DBInit = PX_OK
  142.         Exit Function
  143.     End If
  144.  
  145.     If px Then
  146.         Msg$ = "Unable to start Paradox engine, code: " + Str$(px)
  147.         Msg$ = Msg$ + " Remember to type SHARE before starting Windows"
  148.         MsgBox Msg$, 0 + 16, "Database Initialization"
  149.         End
  150.     End If
  151.  
  152.     DBInit = PX_OK
  153. End Function
  154.  
  155. Function DBExit () As Integer
  156.     '
  157.     '  Shutdown the paradox engine
  158.     '
  159.     DBExit = PXExit()
  160. End Function
  161.  
  162. Function TableOpen (ByVal Tblnum%, ByVal TblName$)
  163.     '
  164.     '  Open a table and allocate one record buffer for it.
  165.     '  Application calls this ro